home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / 3d / vb3dss / vb3d.bas next >
Encoding:
BASIC Source File  |  1995-06-24  |  7.5 KB  |  198 lines
  1. '======================================
  2. ' STDCTL3D  -  Funzioni per un look 3D dei pannelli
  3. '              v. 1.1  -  1995/06/06
  4. '--------------------------------------
  5. ' Functions
  6. ' CTL3D_Start  ---> Call during frmMain load
  7. ' CTL3D_Stop   ---> Call during frmMain unload (and in fatal error routine)
  8. ' CTL3D_VB     ---> Use to check if in VB environment
  9. ' It's required a frmMain in your Project!!!
  10. '--------------------------------------
  11. 'Ver 1.1 Added CTL3D_VB Function
  12. '======================================
  13.  
  14. '======================================
  15. 'STDCTL3D - Give a look 3D to your panels
  16. '
  17. 'Unless other similar routines, this one has two more features:
  18. '1. Uses CTL3DV2.DLL or (if not found) CTL3D.DLL or (if not found) NONE
  19. '2. Checks if in VB environment. This allows to avoid GPF's during
  20. '   program developement or test.
  21.  
  22. 'One, unresolved problem, are GPF's when executable program ends
  23. 'after a non-trapped error.
  24. 'Since VB3 hasn't a centralized error management, you must write your
  25. 'centralized routine (that calls CTL3D_Stop before ending) and
  26. 'must add necessary code to call your centralized routine (suggestions
  27. 'accepted).
  28. '
  29. 'I found CTL3D_VB function very useful. When in VB environment I try
  30. 'my programs as they were registered yet. This avoids me all nag screens
  31. 'watermarks, unwanted sound and so on <g>.
  32. '--------------------------------------
  33. ' For every comment/suggestion, feel free to
  34. ' contact me at 100265,1725@CompuServe.com
  35. '--------------------------------------
  36. ' For other source code (and shareware programs <g>)
  37. ' check for the TCI-SS keyword in Cis:Italfor Section 17
  38. '======================================
  39.  
  40. Option Explicit
  41.  
  42. Dim nm_Ctl3D_Type As Integer  '0 - None  1 - V1  2 - V2
  43. Const CTL3D_NONE = 0
  44. Const CTL3D_V1 = 1
  45. Const CTL3D_V2 = 2
  46. Const FILE_CTL3D_V1 = "CTL3D.DLL"
  47. Const FILE_CTL3D_V2 = "CTL3DV2.DLL"
  48.  
  49. '=================================
  50. '===           API             ===
  51. '=================================
  52.  
  53. '===== Functions
  54.  
  55. '----- CTL3DV1
  56. Declare Function Ctl3DAutoSubclassV1 Lib "Ctl3D.DLL" Alias "Ctl3DAutoSubclass" (ByVal hInst As Integer) As Integer
  57. Declare Function Ctl3DRegisterV1 Lib "Ctl3D.DLL" Alias "Ctl3DRegister" (ByVal hInst As Integer) As Integer
  58. Declare Function Ctl3DUnregisterV1 Lib "Ctl3D.DLL" Alias "Ctl3DUnregister" (ByVal hInst As Integer) As Integer
  59. Declare Function Ctl3DGetVerV1 Lib "Ctl3D.DLL" Alias "Ctl3DGetVer" () As Integer
  60. '----- CTL3DV2
  61. Declare Function Ctl3DAutoSubclassV2 Lib "Ctl3Dv2.DLL" Alias "Ctl3DAutoSubclass" (ByVal hInst As Integer) As Integer
  62. Declare Function Ctl3DRegisterV2 Lib "Ctl3Dv2.DLL" Alias "Ctl3DRegister" (ByVal hInst As Integer) As Integer
  63. Declare Function Ctl3DUnregisterV2 Lib "Ctl3Dv2.DLL" Alias "Ctl3DUnregister" (ByVal hInst As Integer) As Integer
  64. Declare Function Ctl3DGetVerV2 Lib "Ctl3Dv2.DLL" Alias "Ctl3DGetVer" () As Integer
  65. '----- MISC
  66. Declare Function CTL3D_GETMF Lib "Kernel" Alias "GetModuleFileName" (ByVal hModule As Integer, ByVal lpFilename As String, ByVal nSize As Integer) As Integer
  67. Declare Function CTL3D_GETWW Lib "User" Alias "GetWindowWord" (ByVal hWnd As Integer, ByVal nIndex As Integer) As Integer
  68. Declare Function CTL3D_WINDIR Lib "Kernel" Alias "GetWindowsDirectory" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
  69. Declare Function CTL3D_SYSTEM Lib "Kernel" Alias "GetSystemDirectory" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
  70.  
  71. Const GWW_HINSTANCE = (-6)
  72.  
  73. Sub CTL3D_Start ()
  74.     '===== Use this to start the 3D dialogs
  75.     Dim rc_Inst         As Integer
  76.     Dim rc_3D           As Integer
  77.     Dim rc              As Integer
  78.     Dim lpRetStr        As String
  79.     Dim sz_ModuleName   As String
  80.     '----- Is there a loaded form?
  81.     If Forms.Count = 0 Then
  82.         Dim Msg As String
  83.         Msg = "There is no loaded form.  "
  84.         Msg = Msg & "To register your app with CTL3D "
  85.         Msg = Msg & "there must be at least one loaded form.  "
  86.         Msg = Msg & Chr$(13) & Chr$(13)
  87.         Msg = Msg & "Use the Load statement to load a form, "
  88.         Msg = Msg & "use Ctl3D_Start, then unload the form."
  89.         MsgBox Msg, 48, "No Form Loaded"
  90.         Exit Sub
  91.     End If
  92.  
  93.     '----- Find Ctrl3D
  94.     If nm_Ctl3D_Type <> CTL3D_NONE Then
  95.         Exit Sub
  96.     End If
  97.     If CTR3D_FileExist(FILE_CTL3D_V1) Then
  98.         nm_Ctl3D_Type = CTL3D_V1
  99.     End If
  100.     If CTR3D_FileExist(FILE_CTL3D_V2) Then
  101.         nm_Ctl3D_Type = CTL3D_V2
  102.     End If
  103.     '----- Are we in a VB environment?
  104.     lpRetStr = Space$(128)
  105.     rc_Inst = CTL3D_GETWW(Forms(0).hWnd, GWW_HINSTANCE) 'Get the Word of Frm
  106.     rc = CTL3D_GETMF(rc_Inst, lpRetStr, Len(lpRetStr))
  107.     If rc Then
  108.         sz_ModuleName = Left$(lpRetStr, rc)
  109.         ' Get the "." in the file name. Then go back three characters.
  110.         ' FileName should = \VB.EXE, so check for the backslash (\)
  111.         ' because FileName could be GVB.EXE, which isn't the
  112.         ' VB executable name:
  113.         If InStr(sz_ModuleName, "\VB.EXE") Then
  114.             Exit Sub
  115.         End If
  116.     End If
  117.     '----- Activate
  118.     Select Case nm_Ctl3D_Type
  119.     Case CTL3D_NONE
  120.         'Nop
  121.     Case CTL3D_V1
  122.         rc_3D = Ctl3DRegisterV1(rc_Inst)
  123.         rc_3D = Ctl3DAutoSubclassV1(rc_Inst)
  124.     Case CTL3D_V2
  125.         rc_3D = Ctl3DRegisterV2(rc_Inst)
  126.         rc_3D = Ctl3DAutoSubclassV2(rc_Inst)
  127.     End Select
  128. End Sub
  129.  
  130. Sub CTL3D_Stop ()
  131.     '===== This Sub is used to end the 3D effects
  132.     '      IMPORTANT: you must end 3D effects before your app ends
  133.     Dim rc_Get As Integer
  134.     Dim rc_3D As Integer
  135.     rc_Get = CTL3D_GETWW(Forms(0).hWnd, GWW_HINSTANCE) 'Get the Word of Frm
  136.     Select Case nm_Ctl3D_Type
  137.     Case CTL3D_NONE
  138.         'Nop
  139.     Case CTL3D_V1
  140.         rc_3D = Ctl3DUnregisterV1(rc_Get)   ' Unregister the program.
  141.     Case CTL3D_V2
  142.         rc_3D = Ctl3DUnregisterV2(rc_Get)   ' Unregister the program.
  143.     End Select
  144.     nm_Ctl3D_Type = CTL3D_NONE
  145. End Sub
  146.  
  147. Function CTL3D_VB () As Integer
  148.     '===== Use this to find if in a VB environment
  149.     Dim b_Vb            As Integer
  150.     Dim rc_Inst         As Integer
  151.     Dim rc              As Integer
  152.     Dim lpRetStr        As String
  153.     Dim sz_ModuleName   As String
  154.     '----- Are we in a VB environment?
  155.     b_Vb = False
  156.     lpRetStr = Space$(128)
  157.     rc_Inst = CTL3D_GETWW(Forms(0).hWnd, GWW_HINSTANCE) 'Get the Word of Frm
  158.     rc = CTL3D_GETMF(rc_Inst, lpRetStr, Len(lpRetStr))
  159.     If rc Then
  160.         sz_ModuleName = Left$(lpRetStr, rc)
  161.         ' Get the "." in the file name. Then go back three characters.
  162.         ' FileName should = \VB.EXE, so check for the backslash (\)
  163.         ' because FileName could be GVB.EXE, which isn't the
  164.         ' VB executable name:
  165.         If InStr(sz_ModuleName, "\VB.EXE") Then
  166.             b_Vb = True
  167.         End If
  168.     End If
  169.     CTL3D_VB = b_Vb
  170. End Function
  171.  
  172. Private Function CTR3D_FileExist (sz_FileName As String) As Integer
  173.     '===== Returns True if File Exists
  174.     Dim lpRetStr        As String
  175.     Dim rc              As Integer
  176.     Dim sz_File As String
  177.     Dim sz_Test As String
  178.     '===== Start
  179.     lpRetStr = Space$(256)
  180.     sz_File = sz_FileName: GoSub FindFile
  181.     rc = CTL3D_SYSTEM(lpRetStr, Len(lpRetStr))
  182.     sz_File = Left$(lpRetStr, rc) & "\" & sz_FileName: GoSub FindFile
  183.     rc = CTL3D_WINDIR(lpRetStr, Len(lpRetStr))
  184.     sz_File = Left$(lpRetStr, rc) & "\" & sz_FileName: GoSub FindFile
  185.     CTR3D_FileExist = False
  186.     Exit Function
  187.  
  188. FindFile:
  189.      sz_Test = Dir$(sz_File)
  190.      If sz_Test <> "" Then
  191.          CTR3D_FileExist = True
  192.          Exit Function
  193.      End If
  194.      Return
  195.  
  196. End Function
  197.  
  198.